perm filename FILEC.FAI[ESS,JMC] blob sn#005554 filedate 1972-02-04 generic text, type T, neo UTF8
00100	TITLE FILEC
00200	
00300	A←1
00400	B←2
00500	C←3
00600	D←4
00700	PDLEN←10
00800	P←17
00900	DSK←0
01000	ITEM←11
01100	
01200	BEG:	CALLI 0
01300		MOVE P,[IOWD PDLEN,PDLIST]
01400		INIT DSK,0
01500		'DSK   '; THIS COULD HAVE BEEN WRITTEN   SIXBIT /DSK/
01600		XWD 0,IBUFF
01700		HALT
01800		OUTSTR[ASCIZ/FILE = /]
01900		PUSHJ P,GETFIL
02000		MOVE D,[XWD FILNAM,A]
02100		BLT D,D
02200		LOOKUP DSK,A
02300		HALT
02400		SETZ D,
02500	LOOP:	PUSHJ P,READ
02600		JRST DONE
02700		AOJA D,LOOP
02800	DONE:	CLOSE DSK,
02900		RELEAS DSK,
03000		OUTSTR [ASCIZ/
03100	LENGTH = /]
03200		MOVE A,D
03300		PUSHJ P,DECOUT
03400		OUTSTR[ASCIZ/
03500	/]
03600		JRST BEG
03700	
03800	DECOUT:	IDIVI A,12
03900		HRLM B,0(P)
04000		SKIPE A
04100		PUSHJ P,DECOUT
04200		HLRZ A,0(P)
04300		ADDI A,"0";	SAME AS   ADDI A,60
04400		OUTCHR A
04500		POPJ P,
04600	
04700	READ:	SOSLE IBUFF+2; TEST COUNT
04800		JRST READ1
04900		INPUT DSK,
05000		STATZ DSK,7400000; SKIPS IF NO ERRORS
05100		HALT
05200		STATZ DSK,20000; SKIPS IF NOT END OF FILE
05300		POPJ P,
05400	READ1:	ILDB A,IBUFF+1
05500		JUMPE A,READ
05600		AOS (P)
05700		POPJ P,
05800	
05900	GETFIL:	SETZM	FILNAM
06000		MOVE	A,[XWD FILNAM,FILNAM+1]
06100		BLT	A,FILNAM+3
06200		PUSHJ	P,GETSIX
06300		MOVE	D,ITEM
06400		MOVEM	D,FILNAM
06500		CAIE	A,"."		;MUST SEE . AS A DELIMITER
06600		JRST	NOEXT		;NO EXTENSION HERE?
06700		PUSHJ	P,GETSIX
06800		HLLZ	D,ITEM
06900		MOVEM	D,FILNAM+1	;SAVE EXTENSION
07000	NOEXT:	CAIE	A,"["		;LOOK FOR A PPN
07100		JRST	NOPPN		;NOT THERE?
07200		PUSHJ	P,GETSIX	;LOOK
07300		HLLZ	D,ITEM
07400		PUSHJ	P,RJUST		;MAKE R JUST SIXBIT IN D
07500		HRLZM	D,FILNAM+3	;SAVE PPN
07600		CAIE	A,","
07700		CAIN	A,"."
07800		JRST	PRG
07900		CAIE	A,"/"
08000		JRST	NAMERR
08100	PRG:	PUSHJ	P,GETSIX	;GET PRG NAME
08200		HLLZ	D,ITEM
08300		PUSHJ	P,RJUST
08400		HRRM	D,FILNAM+3	;SAVE
08500		CAIN	A,"]"		;BETTER BE THIS OR LF
08600		PUSHJ	P,GETSIX	;READ PAST THE ]
08700	NOPPN:	CAIN	A,12
08800		POPJ	P,
08900	NAMERR:	CLRBFI			;CLEAR TYPE AHEAD
09000		OUTSTR	[ASCIZ/
09100	? FILE NAME ERROR.
09200	FILE = /]
09300		JRST	GETFIL
09400	
09500	GETSIX:	SETZM	ITEM		;PLACE TO MAKE SIXBIT
09600		MOVE	B,[POINT 6,ITEM]	;STUFF 6BIT WITH POINTER
09700	GTSIX1:	INCHWL	A			;READ INTO A
09800		CAIE	A,40		;FLUSH BLANKS
09900		CAIN	A,15
10000		JRST	GTSIX1			;FLUSH CR
10100		CAIE	A,12
10200		CAIN	A,","
10300		POPJ	P,			;RETURN
10400		CAIE	A,"["
10500		CAIN	A,"]"
10600		POPJ	P,
10700		CAIE	A,"."
10800		CAIN	A,"/"
10900		POPJ	P,
11000		CAIL	A,"a"
11100		CAILE	A,"z"
11200		CAIA
11300		TRZ	A,40
11400		SUBI	A,40
11500		JUMPL	A,GTSIX2	;ERROR
11600		CAILE	A,77
11700		JRST	GTSIX2
11800		TLNE	B,770000		;SKIP IF OVERFLO
11900		IDPB	A,B		;STUFF
12000		JRST	GTSIX1
12100	GTSIX2:	SETZB	A,ITEM
12200		POPJ	P,		;TRICKLE OUT AN ERROR
12300	
12400	RJUST:	JUMPE	D,CPOPJ		;NO WORK FOR NOTHING
12500	RJ1:	TRNE	D,77
12600	CPOPJ:	POPJ	P,		;DONE
12700		LSH	D,-6
12800		JRST	RJ1		;LOOP
12900	
13000	
13100	PDLIST: BLOCK PDLEN
13200	IBUFF:	BLOCK 3
13250	FILNAM:	BLOCK	4
13300	END BEG